home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / TRANSMAT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  27.8 KB  |  934 lines
  1. 10  'TRANSMAT - Transmatch Design - 28 SEP 95 rev. 28 SEP 96
  2. 20  'adapted from TUNER.BAS version 1.5 by Brian Egan, ZL1LE
  3. 30  NONOTE=0
  4. 40  IF EX$=""THEN EX$="EXIT"
  5. 50  IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
  6. 60  COMMON EX$,PROG$
  7. 70  CLS:KEY OFF
  8. 80  COLOR 7,0,1
  9. 90  V=0
  10. 100  PI=3.14159
  11. 110  U1$="#####.###"
  12. 120  U2$="#####.##"
  13. 130  UL$=STRING$(80,205)
  14. 140  E$=STRING$(79,32)
  15. 150  '
  16. 160  '.....start
  17. 170  CLS
  18. 180  COLOR 15,2
  19. 190  PRINT " TRANSMATCH DESIGN";TAB(61);"by Brian Egan ZL1LE ";
  20. 200  PRINT STRING$(80,32);
  21. 210  LOCATE CSRLIN-1,20:PRINT "edited for HAMCALC by George Murphy VE3ERP"
  22. 220  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  23. 230  '
  24. 240  '.....main menu
  25. 250  T=(9)
  26. 260  PRINT TAB(T);
  27. 270  PRINT "This program may be used to:"
  28. 280  PRINT TAB(T);
  29. 290  PRINT STRING$(28,196)
  30. 300  PRINT
  31. 310  PRINT " 1.";TAB(T);
  32. 320  PRINT "Design Transmatch circuits of several different types...."
  33. 330  PRINT TAB(T);
  34. 340  PRINT
  35. 350  PRINT " 2.";TAB(T);
  36. 360  PRINT "Compute SWR when transmatch components are varied in value...."
  37. 370  PRINT TAB(T);
  38. 380  PRINT "(e.g. to show effect of variable capacitor/inductor adjustments)."
  39. 390  PRINT
  40. 400  PRINT " 3.";TAB(T);
  41. 410  PRINT "Measure an unknown load by using a matched transmatch as an"
  42. 420  PRINT TAB(T);
  43. 430  PRINT "impedance bridge...."
  44. 440  PRINT
  45. 450  PRINT UL$;
  46. 460  COLOR 0,7:LOCATE 17,22
  47. 470  PRINT " Press 1 to continue or 0 to EXIT....."
  48. 480  COLOR 7,0
  49. 490  Z$=INKEY$:IF Z$=""THEN 490
  50. 500  IF Z$="0"THEN CLS:CHAIN GO$
  51. 510  IF Z$="1"THEN 530
  52. 520  GOTO 490
  53. 530  LOCATE CSRLIN-1:PRINT E$
  54. 540  IF NONOTE=1 THEN 630
  55. 550  LOCATE 17,9:PRINT "Do you wish to read the program notes (y/n)?"
  56. 560  Y$=INKEY$:IF Y$=""THEN 560
  57. 570  IF Y$="N"OR Y$="n"THEN NONOTE=1:GOTO 610
  58. 580  IF Y$="Y"OR Y$="y"THEN 6770
  59. 590  GOTO 560
  60. 600  '
  61. 610  VIEW PRINT 4 TO 24:CLS:VIEW PRINT:LOCATE 4
  62. 620  NONOTE=0
  63. 630  PRINT " PRESS a number in ( ) below to select program option:"
  64. 640  PRINT UL$;
  65. 650  T=3
  66. 660  PRINT TAB(T);"(1)   PI-COUPLER TRANSMATCH DESIGN"
  67. 670  PRINT TAB(T);"(2)   PI-COUPLER IMPEDANCE BRIDGE"
  68. 680  PRINT TAB(T);"(3)   SPC (includes HighPass Tee) TRANSMATCH DESIGN"
  69. 690  PRINT TAB(T);"(4)   SPC (includes HighPass Tee) IMPEDANCE BRIDGE"
  70. 700  PRINT TAB(T);"(5)   LOWPASS TEE TRANSMATCH DESIGN"
  71. 710  PRINT TAB(T);"(6)   LOWPASS TEE IMPEDANCE BRIDGE"
  72. 720  PRINT TAB(T);"(7)   `ULTIMATE' TRANSMATCH DESIGN"
  73. 730  PRINT TAB(T);"(8)   `ULTIMATE' IMPEDANCE BRIDGE"
  74. 740  PRINT TAB(T);"(9)   2-ELEMENT LADDER MATCHING NETWORK"
  75. 750  PRINT
  76. 760  COLOR 14
  77. 770  PRINT TAB(T);"(0)   QUIT"
  78. 780  COLOR 7
  79. 790  Z$=INKEY$:IF Z$=""THEN 790
  80. 800  IF Z$="0"THEN S=10 ELSE S=VAL(Z$)
  81. 810  CLS:COLOR 7,0,1
  82. 820  ON S GOSUB 1020,1660,2060,3530,3970,4970,5330,6400,840,9180
  83. 830  END
  84. 840  CLS:CHAIN"ladder2"
  85. 850  '
  86. 860  '.....format input line
  87. 870  LOCATE CSRLIN-1:PRINT SPC(7);
  88. 880  LOCATE CSRLIN,47:PRINT STRING$(7,".");USING U$;ZZ;
  89. 890  RETURN
  90. 900  '
  91. 910  '.....enter 4 of 5 transmatch parameters for PI-COUPLER and SPC
  92. 920  INPUT " ENTER: Transmatch Input Impedance R1..........(ohms)";R1
  93. 930  ZZ=R1:U$=U2$:GOSUB 860:PRINT " -"
  94. 940  INPUT " ENTER: Load Resistance RL.....................(ohms)";RL
  95. 950  ZZ=RL:U$=U2$:GOSUB 860:PRINT " -"
  96. 960  INPUT " ENTER: Load Reactance.........................(ohms)";XS
  97. 970  ZZ=XS:U$=U2$:GOSUB 860:PRINT " -"
  98. 980  INPUT " ENTER: Frequency...............................(MHz)";F
  99. 990  ZZ=F :U$=U1$:GOSUB 860:PRINT " MHz"
  100. 1000  RETURN
  101. 1010  '
  102. 1020  '.....PI COUPLER transmatch
  103. 1030  T$="PI-COUPLER TRANSMATCH DESIGN"
  104. 1040  T=(80-LEN(T$))/2
  105. 1050  PRINT TAB(T);T$
  106. 1060  PRINT UL$;
  107. 1070  GOSUB 1540   'diagram
  108. 1080  PRINT UL$;
  109. 1090  GOSUB 910    'data input
  110. 1100  '
  111. 1110  '.....calculation of transmatch components
  112. 1120  W=2*PI*F*10^6
  113. 1130  Z=RL^2+XS^2:R2=Z/RL:CP=-XS/Z/W:LMAX=SQR(R1*R2)/W
  114. 1140  IF CP<=1/(W^2*LMAX)THEN 1180
  115. 1150  A1=1+W^2*CP^2*R2^2:A2=-2*W*CP*R2^2:A3=R1*R2-R2*R2
  116. 1160  LM1=-A2/2/A1+SQR(A2^2/4/A1/A1+A3/A1):LM1=LM1/W
  117. 1170  IF LM1<LMAX THEN LMAX=LM1
  118. 1180  PRINT " Inductor must be less than";:PRINT USING "###.###";LMAX*10^6;
  119. 1190  PRINT " uH. ";
  120. 1200  INPUT " ENTER: Value of INDUCTOR in uH: ";L
  121. 1210  IF L>LMAX*10^6 THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1180
  122. 1220  LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1
  123. 1230  PRINT "        Inductor L...................................";USING U1$;L;
  124. 1240  PRINT " >H"
  125. 1250  PRINT "        SWR..........................................    1:1"
  126. 1260  XL=W*L*10^-6
  127. 1270  K=SQR(R1*R2-XL^2)/R1:C1=(1-K)/W/XL:C2=(1-R1/R2*K)/W/XL
  128. 1280  C1A=(1+K)/W/XL:C2A=(1+R1/R2*K)/W/XL
  129. 1290  PRINT " SOLUTION 1:"
  130. 1300  IF C2-CP<0 THEN 1390
  131. 1310  IF K>1 THEN PRINT TAB(9);"(no solution)":GOTO 1380
  132. 1320  ZZ=C1*10^12
  133. 1330  PRINT TAB(9);"Capacitor C1.................................";USING U2$;ZZ;
  134. 1340  PRINT " pF"
  135. 1350  ZZ=(C2-CP)*10^12
  136. 1360  PRINT TAB(9);"Capacitor C2.................................";USING U2$;ZZ;
  137. 1370  PRINT " pF"
  138. 1380  LOCATE 19:PRINT " SOLUTION 2:"
  139. 1390  ZZ=C1A*10^12
  140. 1400  PRINT TAB(9);"Capacitor C1.................................";USING U2$;ZZ;
  141. 1410  PRINT " pF"
  142. 1420  ZZ=(C2A-CP)*10^12
  143. 1430  PRINT TAB(9);"Capacitor C2.................................";USING U2$;ZZ;
  144. 1440  PRINT " pF"
  145. 1450  GOSUB 8770     'calculate *
  146. 1460  LOCATE 23,9:PRINT "Do you wish to vary the inductor size  (y/n)?"
  147. 1470  Y$=INKEY$:IF Y$="" THEN 1470
  148. 1480  IF Y$="Y"OR Y$="y"THEN 1520
  149. 1490  GOSUB 7600    'calculate SWR
  150. 1500  LOCATE CSRLIN-1:PRINT E$
  151. 1510  GOTO 9160
  152. 1520  VIEW PRINT 14 TO 24:CLS:VIEW PRINT:LOCATE 14:GOTO 1180
  153. 1530  '
  154. 1540  '.....PI COUPLER circuit diagram
  155. 1550  COLOR 0,7
  156. 1560  T=26
  157. 1570  LOCATE CSRLIN,T:PRINT "              L              "
  158. 1580  LOCATE CSRLIN,T:PRINT " R1 DEFDBLSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDORORORORORSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDDEFDBL RL "
  159. 1590  LOCATE CSRLIN,T:PRINT " input  CALL           CALL   load "
  160. 1600  LOCATE CSRLIN,T:PRINT "       THENINSTRTHEN C1      THENINSTRTHEN C2    "
  161. 1610  LOCATE CSRLIN,T:PRINT "        CALL           CALL        "
  162. 1620  LOCATE CSRLIN,T:PRINT "  grnd ///         ///       "
  163. 1630  COLOR 7,0
  164. 1640  RETURN
  165. 1650  '
  166. 1660  '.....PI COUPLER impedance bridge
  167. 1670  CLS
  168. 1680  T$="PI-COUPLER IMPEDANCE BRIDGE"
  169. 1690  T=(80-LEN(T$))/2
  170. 1700  PRINT TAB(T);T$
  171. 1710  PRINT UL$;
  172. 1720  GOSUB 1540
  173. 1730  PRINT UL$;
  174. 1740  '
  175. 1750  INPUT " ENTER: Transmatch Input Impedance R1..........(ohms)";R1
  176. 1760  ZZ=R1:U$=U2$:GOSUB 860:PRINT " -"
  177. 1770  INPUT " ENTER: Value of inductor L....................  (>H)";L
  178. 1780  ZZ=L:U$=U2$:GOSUB 860:PRINT " >H"
  179. 1790  INPUT " ENTER: Value of capacitor C1..................  (pF)";C1
  180. 1800  ZZ=C1:U$=U2$:GOSUB 860:PRINT " pF"
  181. 1810  INPUT " ENTER: Value of capacitor C2..................  (pF)";C2
  182. 1820  ZZ=C2:U$=U2$:GOSUB 860:PRINT " pF"
  183. 1830  INPUT " ENTER: Frequency...............................(MHz)";F
  184. 1840  ZZ=F :U$=U1$:GOSUB 860:PRINT " MHz"
  185. 1850  W=2*PI*F*10^6
  186. 1860  C1=C1*10^-12:C2=C2*10^-12:L=L*10^-6
  187. 1870  K=(1-W^2*L*C1):R2=R1*(K^2+W^2*L^2/R1/R1)
  188. 1880  C0=C2+(C1*R1^2*K-L)/R1/R2
  189. 1890  B=1+W^2*C0^2*R2^2
  190. 1900  RL=R2/B:XL=W*C0*R2^2/B
  191. 1910  IF XL<0 THEN SUM$="-" ELSE SUM$="+"
  192. 1920  XL=ABS(XL)
  193. 1930  PRINT TAB(9);"Load impedance...............................";
  194. 1940  PRINT USING "#####.#";INT(RL*10)/10;:PRINT " ";SUM$;" j";INT(XL*10)/10;"-"
  195. 1950  U=RL-R1:V=RL+R1:P=U^2+XL^2:Q=V^2+XL^2
  196. 1960  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  197. 1970  PRINT TAB(9);"Load SWR.....................................";USING U2$;SWR;
  198. 1980  PRINT ":1"
  199. 1990  LOCATE 23,9:PRINT "Do you wish to make another calculation  (y/n)"
  200. 2000  Y$=INKEY$:IF Y$="" THEN 2000
  201. 2010  IF Y$="Y"OR Y$="y" THEN 2040
  202. 2020  LOCATE 23:PRINT E$
  203. 2030  GOTO 9160  'end
  204. 2040  VIEW PRINT 10 TO 24:CLS:VIEW PRINT:LOCATE 10:GOTO 1660
  205. 2050  '
  206. 2060  '.....SPC/HIGHPASS TEE transmatch design
  207. 2070  CLS
  208. 2080  T$="SPC TRANSMATCH DESIGN"
  209. 2090  T=(80-LEN(T$))/2
  210. 2100  PRINT TAB(T);T$
  211. 2110  PRINT UL$;
  212. 2120  GOSUB 3410  'diagram
  213. 2130  PRINT UL$;
  214. 2140  GOSUB 3020  'option menu
  215. 2150  GOSUB 910   'input R1,R,X,& F
  216. 2160  '
  217. 2170  '.....compute transmatch components
  218. 2180  W=2*PI*F*10^6
  219. 2190  IF RL>R1 THEN GOSUB 2640 ELSE GOSUB 2780
  220. 2200  '
  221. 2210  INPUT " ENTER: Value of C1 in pF .....";C1
  222. 2220  IF C1>=C1MAX THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 2210
  223. 2230  LN=CSRLIN-2:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  224. 2240  PRINT TAB(9);"Capacitor C1.................................";USING U2$;C1;
  225. 2250  PRINT " pF"
  226. 2260  PRINT TAB(9);"SWR..........................................    1:1"
  227. 2270  '
  228. 2280  '.....inductor calculation
  229. 2290  A=1/(W^2*RL*(R1-RL)+RL/(C1^2*10^-24*R1))
  230. 2300  CL=SQR(A):GOSUB 2930
  231. 2310  '
  232. 2320  PRINT " SOLUTION 1:"
  233. 2330  ZZ=C*10^12
  234. 2340  PRINT TAB(9);"Capacitor C..................................";USING U2$;ZZ;
  235. 2350  PRINT " pF"
  236. 2360  ZZ=L*10^6
  237. 2370  PRINT TAB(9);"Inductor L...................................";USING U2$;ZZ;
  238. 2380  PRINT " >H"
  239. 2390  GOSUB 8960     '* calculation
  240. 2400  '
  241. 2410  LOCATE 19:PRINT " SOLUTION 2:"
  242. 2420  CL=-SQR(A):GOSUB 2930
  243. 2430  IF XS<=0 OR V=0 THEN PRINT TAB(9);"No second solution":PRINT:GOTO 2560
  244. 2440  IF C<0 THEN LOCATE 20,9:PRINT "No second solution"
  245. 2450  IF C<0 THEN LOCATE 21,9:PRINT "for this value of C1":GOTO 2560
  246. 2460  IF C<=1500*10^-12 AND L>=<10^-9 THEN 2490
  247. 2470  LOCATE 20,9:PRINT "Impractical values"
  248. 2480  LOCATE 21,9:PRINT "for this value of C1":GOTO 2560
  249. 2490  ZZ=C*10^12
  250. 2500  PRINT TAB(9);"Capacitor C..................................";USING U2$;ZZ;
  251. 2510  PRINT " pF"
  252. 2520  ZZ=L*10^6
  253. 2530  PRINT TAB(9);"Inductor L...................................";USING U2$;ZZ;
  254. 2540  PRINT " >H"
  255. 2550  GOSUB 9010  'calculate *
  256. 2560  LOCATE 23,9:PRINT "Do you wish to vary C1 (y/n)?:"
  257. 2570  Y$=INKEY$:IF Y$=""THEN 2570
  258. 2580  IF Y$="Y"OR Y$="y"THEN 2620
  259. 2590  GOSUB 7900  'calculate SWR
  260. 2600  LOCATE CSRLIN-1:PRINT E$
  261. 2610  GOTO 9160
  262. 2620  VIEW PRINT 14 TO 24:CLS:VIEW PRINT:LOCATE 14:GOTO 2190
  263. 2630  '
  264. 2640  '.....subroutine for RL>R1
  265. 2650  C1A=1/W/SQR(R1*(RL-R1))*10^12
  266. 2660  C1B=1/W*SQR(RL/R1)/SQR(XS^2+RL*(RL-R1))*10^12
  267. 2670  LOCATE CSRLIN,9
  268. 2680  IF XS<=0 THEN PRINT "C1 max.=";USING "####.#";C1B;:PRINT "   pF"
  269. 2690  IF XS> 0 THEN PRINT "C1 max.=";USING "####.#";C1A;:PRINT "   pF"
  270. 2700  IF XS> 0 THEN LOCATE 23 ELSE GOTO 2740
  271. 2710  ZZ=INT(10*C1B)/10+0.1
  272. 2720  PRINT TAB(9);"NOTE: There are TWO solutions in the range";ZZ"< C1 <";
  273. 2730  PRINT USING "####.#";C1A;:PRINT " pF.":V=1
  274. 2740  IF XS<=0 THEN C1MAX=C1B ELSE C1MAX=C1A
  275. 2750  LOCATE 15
  276. 2760  RETURN
  277. 2770  '
  278. 2780  '.....subroutine for RL<=R1
  279. 2790  IF(RL^2+XS^2)<=R1^2 THEN C1MAX=750:PRINT " C1 max.= 749.9 pF":RETURN
  280. 2800  C1B=1/W*SQR(RL/R1)/SQR(XS^2+RL*(RL-R1))*10^12
  281. 2810  IF XS<=0 THEN C1MAX=C1B ELSE C1MAX=750
  282. 2820  IF C1MAX>750 THEN C1MAX=750
  283. 2830  IF XS<=0 THEN PRINT " C1 max.=";INT(C1MAX*10)/10-0.1;" pF"
  284. 2840  IF XS>0 THEN PRINT " C1 max.= 749.9 pF"
  285. 2850  IF XS>0 THEN LOCATE 23 ELSE RETURN
  286. 2860  IF C1B>=750 THEN RETURN
  287. 2870  ZZ=INT(10*C1B+1)/10
  288. 2880  PRINT TAB(9);"NOTE: There are TWO solutions in the range";ZZ;
  289. 2890  PRINT "< C1 < 749.9 pF.":V=1
  290. 2900  LOCATE 15
  291. 2910  RETURN
  292. 2920  '
  293. 2930  '.....subroutine L and C continued
  294. 2940  CP=CL/(1+W^2*CL^2*RL^2):C=1/(W*XS+1/CL)
  295. 2950  IF VER$="1"THEN C2=C+CP:GOTO 2990
  296. 2960  IF VER$="2"THEN C2=C1*10^-12+CP:GOTO 2990
  297. 2970  IF VER$="3"THEN C2=CP
  298. 2980  REM:IF VER$="3"AND C2<0 THEN RETURN
  299. 2990  R2=R1+1/(W^2*C1^2*10^-24*R1):L=1/(W^2*C2+1/(C1*10^-12*R1*R2))
  300. 3000  RETURN
  301. 3010  '
  302. 3020  '.....SPC menu
  303. 3030  PRINT " PRESS number in ( ) below to select version:"
  304. 3040  PRINT UL$;
  305. 3050  PRINT "   (1) SPC TRANSMATCH MODE I  (Cn =  C)"
  306. 3060  PRINT "   (2) SPC TRANSMATCH MODE II (Cn = C1)"
  307. 3070  PRINT "   (3) HIGH PASS TEE          (Cn =  0)"
  308. 3080  VER$=INKEY$:IF VER$="" THEN 3080
  309. 3090  IF VAL(VER$)>3 OR VAL(VER$)<1 THEN 3080
  310. 3100  COLOR 0,7
  311. 3110   IF VER$<>"1"THEN 3140
  312. 3120  C$="C":GOSUB 3340
  313. 3130  LOCATE 6,47:PRINT "=C":LOCATE 1,53:PRINT "(Mode I: Cn=C)":GOTO 3220
  314. 3140   IF VER$<>"2"THEN 3170
  315. 3150  C$="C1":GOSUB 3340
  316. 3160  LOCATE 6,47:PRINT "=C1":LOCATE 1,53:PRINT "(Mode II: Cn=C1)":GOTO 3220
  317. 3170   IF VER$<>"3"THEN 3200
  318. 3180  GOSUB 3250:GOTO 3190
  319. 3190  LOCATE 6,47:PRINT "=0":LOCATE 1,53:PRINT "(High Pass Tee: Cn=0)":GOTO 3220
  320. 3200  GOTO 3080
  321. 3210  '
  322. 3220  COLOR 7,0:VIEW PRINT 10 TO 24:CLS:VIEW PRINT:LOCATE 10
  323. 3230  RETURN
  324. 3240  '
  325. 3250  '.....erase Cn from diagram
  326. 3260  COLOR 0,7
  327. 3270  LOCATE 4,T+16:PRINT "SOUND"
  328. 3280  LOCATE 5,T+16:PRINT " "
  329. 3290  LOCATE 6,T+15:PRINT "   (Cn=0)"
  330. 3300  LOCATE 7,T+16:PRINT " "
  331. 3310  LOCATE 8,T+15:PRINT "   "
  332. 3320  RETURN
  333. 3330  '
  334. 3340  '.....add split-stator note to diagram
  335. 3350  COLOR 7,0
  336. 3360  LOCATE 5,56:PRINT C$;" & Cn may be a split-"
  337. 3370  LOCATE 6,56:PRINT "stator capacitor"
  338. 3380  COLOR 0,7
  339. 3390  RETURN
  340. 3400  '
  341. 3410  '.....SPC diagram
  342. 3420  COLOR 0,7
  343. 3430  T=26
  344. 3440  LOCATE CSRLIN,T:PRINT "        C1          C        "
  345. 3450  LOCATE CSRLIN,T:PRINT " R1 DEFDBLSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDDEFDBL RL "
  346. 3460  LOCATE CSRLIN,T:PRINT " input      CALL   CALL       load "
  347. 3470  LOCATE CSRLIN,T:PRINT "      VARPTROROROROROR'  THENINSTRTHEN Cn        "
  348. 3480  LOCATE CSRLIN,T:PRINT "      CALL  L      CALL            "
  349. 3490  LOCATE CSRLIN,T:PRINT "     /// grnd  ///           "
  350. 3500  COLOR 7,0
  351. 3510  RETURN
  352. 3520  '
  353. 3530  '.....SPC/HIGHPASS TEE impedance bridge
  354. 3540  CLS
  355. 3550  T$="SPC IMPEDANCE BRIDGE"
  356. 3560  T=(80-LEN(T$))/2
  357. 3570  PRINT TAB(T);T$
  358. 3580  PRINT UL$;
  359. 3590  GOSUB 3410  'diagram
  360. 3600  PRINT UL$;
  361. 3610  GOSUB 3020  'menu
  362. 3620  '
  363. 3630  INPUT " ENTER: Transmatch Input Impedance R1..........(ohms)";R1
  364. 3640  ZZ=R1:U$=U2$:GOSUB 860:PRINT " -"
  365. 3650  INPUT " ENTER: Value of inductor L....................  (>H)";L
  366. 3660  ZZ=L: U$=U2$:GOSUB 860:PRINT " >H"
  367. 3670  INPUT " ENTER: Value of capacitor C1..................  (pF)";C1
  368. 3680  ZZ=C1:U$=U2$:GOSUB 860:PRINT " pF"
  369. 3690  INPUT " ENTER: Value of capacitor C...................  (pF)";C
  370. 3700  ZZ=C: U$=U2$:GOSUB 860:PRINT " pF"
  371. 3710  INPUT " ENTER: Frequency...............................(MHz)";F
  372. 3720  ZZ=F :U$=U1$:GOSUB 860:PRINT " MHz"
  373. 3730  W=2*PI*F*10^6:C=C*10^-12:C1=C1*10^-12:L=L*10^-6
  374. 3740  IF VER$="1"THEN CN=C:GOTO 3780
  375. 3750  IF VER$="2"THEN CN=C1:GOTO 3770
  376. 3760  IF VER$="3"THEN CN=0
  377. 3770  L=1/(1/L-W^2*(CN-C))
  378. 3780  R2=R1+1/(W^2*C1^2*R1)
  379. 3790  CP=C1/(1+W^2*C1^2*R1^2):C2=C+CP
  380. 3800  B=1-W^2*L*C2:A=B^2+W^2*L^2/R2/R2
  381. 3810  RL=W^2*L^2/A/R2:XS=1/W/C-W*L*B/A
  382. 3820  IF XS<0 THEN SUM$="-"ELSE SUM$="+"
  383. 3830  XS=ABS(XS)
  384. 3840  PRINT TAB(9);"Load impedance...............................";
  385. 3850  PRINT USING "#####.#";INT(RL*10)/10;:PRINT " ";SUM$;" j";INT(XS*10)/10;"-"
  386. 3860  U=RL-R1:V=RL+R1:P=U^2+XS^2:Q=V^2+XS^2
  387. 3870  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  388. 3880  PRINT TAB(9);"Load SWR.....................................";USING U2$;SWR;
  389. 3890  PRINT ":1"
  390. 3900  LOCATE 23,9: PRINT "Do you wish to make another calculation  (y/n)"
  391. 3910  Y$=INKEY$:IF Y$="" THEN 3910
  392. 3920  IF Y$="Y"OR Y$="y"THEN 3950
  393. 3930  LOCATE 23:PRINT E$
  394. 3940  GOTO 9160  'end
  395. 3950  VIEW PRINT 10 TO 24:CLS:VIEW PRINT:LOCATE 10:GOTO 3530
  396. 3960  '
  397. 3970  '.....LOWPASS TEE transmatch design
  398. 3980  CLS
  399. 3990  T$="LOWPASS TEE TRANSMATCH DESIGN"
  400. 4000  T=(80-LEN(T$))/2
  401. 4010  PRINT TAB(T);T$
  402. 4020  PRINT UL$;
  403. 4030  GOSUB 4850     'schematic
  404. 4040  PRINT UL$;
  405. 4050  GOSUB 910      'input R1,RL,X,F
  406. 4060  '
  407. 4070  '.....compute transmatch components
  408. 4080  W=2*PI*F*10^6
  409. 4090  IF RL>R1 THEN GOSUB 4550 ELSE GOSUB 4680
  410. 4100  INPUT " ENTER: Value of L1 in >H .....";L1
  411. 4110  IF L1<L1MIN THEN LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 4100
  412. 4120  LN=CSRLIN-2:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  413. 4130  ZZ=L1
  414. 4140  PRINT TAB(9);"Inductor L1..................................";USING U2$;ZZ;
  415. 4150  PRINT " >H"
  416. 4160  PRINT TAB(9);"SWR..........................................    1:1"
  417. 4170  '
  418. 4180  '.....Inductor L2 calculation
  419. 4190  A=RL*(R1-RL)+(W^2*L1^2*10^-12*RL/R1)
  420. 4200  X=SQR(A):GOSUB 4800
  421. 4210  '
  422. 4220  LOCATE 16:PRINT " SOLUTION 1:"
  423. 4230  ZZ=C*10^12
  424. 4240  PRINT TAB(9);"Capacitor C..................................";USING U2$;ZZ;
  425. 4250  PRINT " pF"
  426. 4260  ZZ=L2*10^6
  427. 4270  PRINT TAB(9);"Inductor L2..................................";USING U2$;ZZ;
  428. 4280  PRINT " >H"
  429. 4290  GOSUB 8840   'calculate *
  430. 4300  '
  431. 4310  LOCATE 19:PRINT " SOLUTION 2:"
  432. 4320  X=-SQR(A):GOSUB 4800   'subroutine L and C continued
  433. 4330  IF XS>=0 OR V=0 THEN PRINT TAB(9);"No second solution":PRINT:GOTO 4440
  434. 4340  IF L2<0 THEN LOCATE 20,9:PRINT "No second solution"
  435. 4350  IF L2<0 THEN LOCATE 21,9:PRINT "for this value of L1":GOTO 4440
  436. 4360  IF C>1500*10^-12 OR L2<10^-9 OR C<O THEN GOSUB 4510:GOTO 4440
  437. 4370  GOSUB 8900   'calculate *
  438. 4380  ZZ=C*10^12
  439. 4390  PRINT TAB(9);"Capacitor C..................................";USING U2$;ZZ;
  440. 4400  PRINT " pF"
  441. 4410  ZZ=L2*10^6
  442. 4420  PRINT TAB(9);"Inductor L2..................................";USING U2$;ZZ;
  443. 4430  PRINT " >H"
  444. 4440  LOCATE 23,9:PRINT "Do you wish to vary L1 (y/n)?:"
  445. 4450  Y$=INKEY$:IF Y$=""THEN 4450
  446. 4460  IF Y$="Y"OR Y$="y"THEN 4500
  447. 4470  GOSUB 8230   'calculate SWR
  448. 4480  LOCATE CSRLIN-1:PRINT E$
  449. 4490  GOTO 9160    'end
  450. 4500  VIEW PRINT 14 TO 24:CLS:VIEW PRINT:LOCATE 14:GOTO 4090
  451. 4510  PRINT TAB(9);"Impractical values"
  452. 4520  PRINT TAB(9);"for this value of L1"
  453. 4530  RETURN
  454. 4540  '
  455. 4550  '.....subroutine for RL>R1
  456. 4560  L1A=1/W*SQR(R1*(RL-R1))*10^6
  457. 4570  L1B=1/W*SQR(R1/RL)*SQR(XS^2+RL*(RL-R1))*10^6
  458. 4580  IF XS>=0 THEN PRINT " L1 min.=";:PRINT USING "###.###";L1B;:PRINT " >H"
  459. 4590  IF XS<=0 THEN PRINT " L1 min.=";:PRINT USING "###.###";L1A;:PRINT " >H"
  460. 4600  IF XS<0 THEN LOCATE 23 ELSE 4640
  461. 4610  PRINT " NOTE:  There are TWO solutions in the range";
  462. 4620  PRINT USING "##.###";L1A;:PRINT " < L1 <";:PRINT USING "##.###";L1B;
  463. 4630  PRINT " >H.":V=1
  464. 4640  IF XS>0 THEN L1MIN=L1B ELSE L1MIN=L1A
  465. 4650  LOCATE 15
  466. 4660  RETURN
  467. 4670  '
  468. 4680  '.....subroutine for RL<=R1
  469. 4690  IF(RL^2+XS^2)<=R1*RL THEN L1MIN=0.02:PRINT " L1 min.= .019 >H. ":RETURN
  470. 4700  L1B=1/W*SQR(R1/RL)*SQR(XS^2+RL*(RL-R1))*10^6
  471. 4710  IF XS>0 THEN L1MIN=L1B ELSE L1MIN=0.02
  472. 4720  IF XS>0 THEN PRINT " L1 min.=";:PRINT USING "###.###";L1B;
  473. 4730  IF XS>0 THEN PRINT " >H. " ELSE PRINT " L1 min.= .019 >H. "
  474. 4740  IF XS<=0 THEN LOCATE 23 ELSE RETURN
  475. 4750  PRINT " NOTE:  There are TWO solutions in the range 0.019 < L1 < ";
  476. 4760  PRINT INT(100*L1B)/100;" >H.":V=1
  477. 4770  LOCATE 15
  478. 4780  RETURN
  479. 4790  '
  480. 4800  '.....subroutine L and C continued
  481. 4810  L2=1/W*(X-XS)
  482. 4820  R2=RL+X*X/RL:C=L1*10^-6/R1/R2+X/W/RL/R2
  483. 4830  RETURN
  484. 4840  '
  485. 4850  '.....schematic view
  486. 4860  COLOR 0,7
  487. 4870  T=26
  488. 4880  LOCATE CSRLIN,T:PRINT "         L1       L2         "
  489. 4890  LOCATE CSRLIN,T:PRINT " R1 DEFDBLSOUNDSOUNDSOUNDORORORORSOUNDSOUNDBSAVESOUNDSOUNDORORORORSOUNDSOUNDSOUNDDEFDBL RL "
  490. 4900  LOCATE CSRLIN,T:PRINT " input        CALL         load "
  491. 4910  LOCATE CSRLIN,T:PRINT "             THENINSTRTHEN C           "
  492. 4920  LOCATE CSRLIN,T:PRINT "              CALL              "
  493. 4930  LOCATE CSRLIN,T:PRINT "             /// grnd        "
  494. 4940  COLOR 7,0
  495. 4950  RETURN
  496. 4960  '
  497. 4970  '.....LOWPASS TEE impedance bridge
  498. 4980  CLS
  499. 4990  T$="LOWPASS TEE IMPEDANCE BRIDGE"
  500. 5000  T=(80-LEN(T$))/2
  501. 5010  PRINT TAB(T);T$
  502. 5020  PRINT UL$;
  503. 5030  GOSUB 4850    'diagram
  504. 5040  PRINT UL$;
  505. 5050  INPUT " ENTER: Transmatch Input Impedance R1..........(ohms)";R1
  506. 5060  ZZ=R1:U$=U2$:GOSUB 860:PRINT " -"
  507. 5070  INPUT " ENTER: Value of inductor L1...................(ohms)";L1
  508. 5080  ZZ=L1:U$=U2$:GOSUB 860:PRINT " >H"
  509. 5090  INPUT " ENTER: Value of inductor L2...................(ohms)";L2
  510. 5100  ZZ=L2:U$=U2$:GOSUB 860:PRINT " >H"
  511. 5110  INPUT " ENTER: Value of capacitor C.....................(pF)";C
  512. 5120  ZZ=C :U$=U2$:GOSUB 860:PRINT " pF"
  513. 5130  INPUT " ENTER: Frequency...............................(MHz)";F
  514. 5140  ZZ=F :U$=U1$:GOSUB 860:PRINT " MHz
  515. 5150  W=2*PI*F*10^6:C=C*10^-12:L1=L1*10^-6:L2=L2*10^-6
  516. 5160  R2=R1+W^2*L1^2/R1:CP=C-L1/R1/R2:K=1/R2/R2+W^2*CP^2
  517. 5170  RL=1/R2/K:XL=W*CP/K-W*L2   'conjugate
  518. 5180  IF XL<0 THEN SUM$="-"ELSE SUM$="+"
  519. 5190  XL=ABS(XL)
  520. 5200  PRINT TAB(9);"Load impedance...............................";
  521. 5210  PRINT USING "#####.#";INT(RL*10)/10;:PRINT " ";SUM$;" j";INT(XL*10)/10;"-"
  522. 5220  U=RL-R1:V=RL+R1:P=U^2+XL^2:Q=V^2+XL^2
  523. 5230  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  524. 5240  PRINT TAB(9);"Load SWR.....................................";USING U2$;SWR;
  525. 5250  PRINT ":1"
  526. 5260  LOCATE 23,9:PRINT "Do you wish to make another calculation?  (y/n)"
  527. 5270  Y$=INKEY$:IF Y$=""THEN 5270
  528. 5280  IF Y$="Y"OR Y$="y"THEN 5310
  529. 5290  LOCATE 23:PRINT E$
  530. 5300  GOTO 9160
  531. 5310  VIEW PRINT 10 TO 24:CLS:VIEW PRINT:LOCATE 10:GOTO 5050
  532. 5320  '
  533. 5330  '.....ULTIMATE transmatch design
  534. 5340  CLS:V=0
  535. 5350  T$="`ULTIMATE' TRANSMATCH DESIGN"
  536. 5360  T=(80-LEN(T$))/2
  537. 5370  PRINT TAB(T);T$
  538. 5380  PRINT UL$;
  539. 5390  GOSUB 5950   'diagram
  540. 5400  PRINT UL$;
  541. 5410  GOSUB 910    'input R1, R, X, F
  542. 5420  '
  543. 5430  '.....compute transmatch components
  544. 5440  W=2*PI*F*10^6
  545. 5450  IF RL>4*R1 THEN GOSUB 6100 ELSE GOSUB 6250
  546. 5460  INPUT " ENTER: Value of C1a, C1b (each) in pF .....";C1
  547. 5470  IF C1>=C1MAX THEN GOTO 6100
  548. 5480  LN=CSRLIN-2:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  549. 5490  PRINT TAB(9);"C1a, C1b (each)..............................";USING U2$;C1;
  550. 5500  PRINT " pF"
  551. 5510  PRINT TAB(9);"SWR..........................................    1:1"
  552. 5520  '
  553. 5530  '.....inductor calculation
  554. 5540  A=1/(W^2*RL*(4*R1-RL)+RL/(C1^2*10^-24*R1))
  555. 5550  CL=SQR(A):GOSUB 5880
  556. 5560  '
  557. 5570  PRINT " SOLUTION 1:"
  558. 5580  ZZ=C*10^12
  559. 5590  PRINT "        Capacitor C..................................";USING U2$;ZZ;
  560. 5600  PRINT " pF"
  561. 5610  ZZ=L*10^6
  562. 5620  PRINT "        Inductor L...................................";USING U2$;ZZ;
  563. 5630  PRINT " >H"
  564. 5640  GOSUB 9060    'calculate *
  565. 5650  CL=-SQR(A):GOSUB 5880
  566. 5660  '
  567. 5670  LOCATE 19:PRINT " SOLUTION 2:"
  568. 5680  IF XS<=0 OR V=0 THEN PRINT TAB(9);"No second solution":PRINT:GOTO 5800
  569. 5690  IF C<0 THEN PRINT TAB(9);"No second solution"
  570. 5700  IF C<0 THEN PRINT TAB(9);"for this value of C1":GOTO 5800
  571. 5710  IF C>1500*10^-12 OR L<10^-9 THEN LOCATE 20,9:PRINT "Impractical values for"
  572. 5720  IF C>1500*10^-12 OR L<10^-9 THEN PRINT TAB(9);"this value of C1":GOTO 5800
  573. 5730  ZZ=C*10^12
  574. 5740  PRINT TAB(9);"Capacitor C..................................";USING U2$;ZZ;
  575. 5750  PRINT " pF"
  576. 5760  ZZ=L*10^6
  577. 5770  PRINT TAB(9);"Inductor L...................................";USING U2$;ZZ;
  578. 5780  PRINT " >H"
  579. 5790  GOSUB 9110   'calculate *
  580. 5800  LOCATE 23,9:PRINT "Do you wish to vary C1 (y/n)?:"
  581. 5810  Y$=INKEY$:IF Y$=""THEN 5810
  582. 5820  IF Y$="Y"OR Y$="y"THEN 5860
  583. 5830  GOSUB 8490   'calculate SWR
  584. 5840  LOCATE CSRLIN-1:PRINT E$
  585. 5850  GOTO 9160   'end
  586. 5860  VIEW PRINT 14 TO 24:CLS:VIEW PRINT:LOCATE 14:GOTO 5450
  587. 5870  '
  588. 5880  '.....calculate L and C values
  589. 5890  K=W*CL*RL
  590. 5900  C2=CL/(1+K^2):C=1/(W*XS+1/CL)
  591. 5910  R2=RL*(1+1/(K^2))
  592. 5920  L1=R2/(W^2*C1*10^-12*(R2-2*R1)):L=L1/(1+W^2*L1*C2)
  593. 5930  RETURN
  594. 5940  '
  595. 5950  '.....schematic view
  596. 5960  COLOR 0,7
  597. 5970  T=26
  598. 5980  LOCATE CSRLIN,T:PRINT "            C1a     C        "
  599. 5990  LOCATE CSRLIN,T:PRINT " R1 DEFDBLSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDDEFDBL RL "
  600. 6000  LOCATE CSRLIN,T:PRINT " input  CALL       CALL       load "
  601. 6010  LOCATE CSRLIN,T:PRINT "       THENINSTRTHEN C1b  CLSORORORORORCOLOR      "
  602. 6020  LOCATE CSRLIN,T:PRINT "        CALL          L  CALL      "
  603. 6030  LOCATE CSRLIN,T:PRINT "       /// grnd      ///     "
  604. 6040  COLOR 7,0
  605. 6050  LN=CSRLIN:LOCATE LN-4,56:PRINT "C1a, C1b can be a split-"
  606. 6060  LOCATE CSRLIN,56:PRINT "stator variable capacitor"
  607. 6070  LOCATE LN
  608. 6080  RETURN
  609. 6090  '
  610. 6100  '.....subroutine for RL>4*R1
  611. 6110  C1A=1/W/SQR(R1*(RL-4*R1))*10^12
  612. 6120  C1B=1/W*SQR(RL/R1)/SQR(XS^2+RL*(RL-4*R1))*10^12
  613. 6130  IF XS<=0 THEN PRINT " C1a, C1b max.(each)=";:PRINT USING "####.#";C1B;
  614. 6140  IF XS<=0 THEN PRINT " pF"
  615. 6150  IF XS> 0 THEN PRINT " C1a, C1b max.(each)=";:PRINT USING "####.#";C1A;
  616. 6160  IF XS> 0 THEN PRINT " pF"
  617. 6170  IF XS> 0 THEN LOCATE 23 ELSE 6210
  618. 6180  PRINT " NOTE:  There are TWO solutions in the range";
  619. 6190  PRINT INT(10*C1B+1)/10;"< C1a/C1b <";:PRINT USING "####.#";C1A;
  620. 6200  PRINT " pF.":V=1
  621. 6210  IF XS<=0 THEN C1MAX=C1B ELSE C1MAX=C1A
  622. 6220  LOCATE 15
  623. 6230  RETURN
  624. 6240  '
  625. 6250  '.....subroutine for RL<4*R1
  626. 6260  IF (RL^2+XS^2)<=(4*R1*RL)THEN C1MAX=750
  627. 6270  IF (RL^2+XS^2)<=(4*R1*RL)THEN PRINT" C1a, C1b max.(each)= 749.99 pF":RETURN
  628. 6280  C1B=1/W*SQR(RL/R1)/SQR(XS^2+RL*(RL-4*R1))*10^12
  629. 6290  IF XS<=0 THEN C1MAX=C1B ELSE C1MAX=750
  630. 6300  IF C1MAX>750 THEN C1MAX=750
  631. 6310  IF XS<=0 THEN PRINT " C1a, C1b max.(each)= ";INT(C1MAX*10)/10;" pF"
  632. 6320  IF XS>0  THEN PRINT " C1a, C1b max.(each)=  749.9 pF"
  633. 6330  IF XS>0  THEN LOCATE 23 ELSE RETURN
  634. 6340  IF C1B>=750 THEN RETURN
  635. 6350  PRINT " NOTE:  There are TWO solutions in the range";
  636. 6360  PRINT INT(10*C1B+1)/10;"< C1a/C1b < 749.99 pF.":V=1
  637. 6370  LOCATE 15
  638. 6380  RETURN
  639. 6390  '
  640. 6400  '.....ULTIMATE impedance bridge
  641. 6410  CLS
  642. 6420  T$="`ULTIMATE' IMPEDANCE BRIDGE "
  643. 6430  T=(80-LEN(T$))/2
  644. 6440  PRINT TAB(T);T$
  645. 6450  PRINT UL$;
  646. 6460  GOSUB 5950  'schematic view
  647. 6470  PRINT UL$;
  648. 6480  INPUT " ENTER: Transmatch Input Impedance R1..........(ohms)";R1
  649. 6490  ZZ=R1:U$=U2$:GOSUB 860:PRINT " -"
  650. 6500  INPUT " ENTER: Value of inductor L....................(ohms)";L
  651. 6510  ZZ=L:U$=U2$:GOSUB 860:PRINT " -"
  652. 6520  INPUT " ENTER: Value of capacitor C1....................(pF)";C1
  653. 6530  ZZ=C1:U$=U2$:GOSUB 860:PRINT " pF"
  654. 6540  INPUT " ENTER: Value of capacitor C.....................(pF)";C
  655. 6550  ZZ=C:U$=U2$:GOSUB 860:PRINT " pF"
  656. 6560  INPUT " ENTER: Frequency...............................(MHz)";F
  657. 6570  ZZ=F:U$=U1$:GOSUB 860:PRINT " MHz"
  658. 6580  W=2*PI*F*10^6:C=C*10^-12:C1=C1*10^-12:L=L*10^-6
  659. 6590  K=2*W*C1*R1:R2=(1+K^2)/(W^2*C1^2*R1)
  660. 6600  CP=C1*(1+K^2/2)/(1+K^2):T=1-W^2*L*CP:RL=W^2*L^2*R2/(R2^2*T^2+W^2*L^2)
  661. 6610  XS=1/W/C-W*L*R2^2*T/((R2^2*T^2)+W^2*L^2)
  662. 6620  IF XS<0 THEN SUM$="-"ELSE SUM$="+"
  663. 6630  XS=ABS(XS)
  664. 6640  PRINT TAB(9);"Load impedance...............................";
  665. 6650  PRINT USING "#####.#";INT(RL*10)/10;:PRINT " ";SUM$;" j";INT(XS*10)/10;"-"
  666. 6660  U=RL-R1:V=RL+R1:P=U^2+XS^2:Q=V^2+XS^2
  667. 6670  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  668. 6680  PRINT TAB(9);"Load SWR.....................................";USING U2$;SWR;
  669. 6690  PRINT ":1"
  670. 6700  LOCATE 23,9: PRINT "Do you wish to make another calculation  (y/n)"
  671. 6710  Y$=INKEY$:IF Y$=""THEN 6710
  672. 6720  IF Y$="Y"OR Y$="y"THEN 6750
  673. 6730  LOCATE 23:PRINT E$
  674. 6740  GOTO 9160   'end
  675. 6750  VIEW PRINT 10 TO 24:CLS:VIEW PRINT:LOCATE 10:GOTO 6480
  676. 6760  '
  677. 6770  '.....data entry notes
  678. 6780  VIEW PRINT 4 TO 24:CLS:VIEW PRINT:LOCATE 4
  679. 6790  NONOTE=1
  680. 6800  T=7
  681. 6810  PRINT" 1.";TAB(T);
  682. 6820  PRINT"Each transmatch design option has a paired impedance bridge option"
  683. 6830  PRINT TAB(T);
  684. 6840  PRINT"which may be used either to (a) confirm the accuracy of the design"
  685. 6850  PRINT TAB(T);
  686. 6860  PRINT"procedures or (b) determine values (R and X) of an unknown load."
  687. 6870  PRINT TAB(T);
  688. 6880  PRINT"Case (b) assumes bridge components have been calibrated since"
  689. 6890  PRINT TAB(T);
  690. 6900  PRINT"component values under matched conditions are used as program input."
  691. 6910  PRINT
  692. 6920  PRINT" 2.";TAB(T);
  693. 6930  PRINT"Each design option includes the provision to determine the value of"
  694. 6940  PRINT TAB(T);
  695. 6950  PRINT"transmatch input SWR as component values are varied."
  696. 6960  PRINT
  697. 6970  PRINT" 3.";TAB(T);
  698. 6980  PRINT"CAUTION: CARE MUST BE EXERCISED WHEN ENTERING NUMERICAL DATA."
  699. 6990  PRINT
  700. 7000  PRINT TAB(T);
  701. 7010  PRINT"If a non-numerical character is entered where a numerical character"
  702. 7020  PRINT TAB(T);
  703. 7030  PRINT"is expected (numbers may contain a decimal point and reactance"
  704. 7040  PRINT TAB(T);
  705. 7050  PRINT"values may be negative) a GWBASIC error checking routine halts the"
  706. 7060  PRINT TAB(T);
  707. 7070  PRINT"execution of the program. The screen display will be overwritten"
  708. 7080  PRINT TAB(T);
  709. 7090  PRINT"with the error message `REDO FROM START' plus a prompt to re-enter"
  710. 7100  PRINT TAB(T);
  711. 7110  PRINT"the correct data. The program can be continued by responding to the"
  712. 7120  PRINT TAB(T);
  713. 7130  PRINT"prompt but legibility of the display will be impaired. It is"
  714. 7140  PRINT TAB(T);
  715. 7150  PRINT"suggested that the program be halted and re-run. To halt the program"
  716. 7160  PRINT TAB(T);
  717. 7170  PRINT"hold down the CONTROL key and press the PAUSE key. Then press the F2"
  718. 7180  PRINT TAB(T);
  719. 7190  PRINT"key to re-start the program.";
  720. 7200  '
  721. 7210  GOSUB 9210
  722. 7220  LOCATE 25,1:PRINT E$;
  723. 7230  VIEW PRINT 4 TO 24:CLS:VIEW PRINT:LOCATE 4
  724. 7240  '
  725. 7250  PRINT " 4.";TAB(T);
  726. 7260  PRINT"For SWR calculations the data input format is N1,N2,N3 (i.e. inputs"
  727. 7270  PRINT TAB(T);
  728. 7280  PRINT"are separated by commas, e.g. 1.3,50,75 )."
  729. 7290  PRINT
  730. 7300  PRINT " 5.";TAB(T);
  731. 7310  PRINT"Values of the normalized tuner loss factor, (*), are evaluated and"
  732. 7320  PRINT TAB(T);
  733. 7330  PRINT"listed for all tuner designs. These values provide a relative"
  734. 7340  PRINT TAB(T);
  735. 7350  PRINT"measure of tuner power dissipation (the lower the *, the lower the"
  736. 7360  PRINT TAB(T);
  737. 7370  PRINT"loss). In evaluating * it is assumed that losses in tuner capacitors"
  738. 7380  PRINT TAB(T);
  739. 7390  PRINT"are negligible. Tuner efficiency is equal to [ 1 - */Q ] where Q is"
  740. 7400  PRINT TAB(T);
  741. 7410  PRINT"the quality factor of the inductor(s), i.e. the ratio of inductive"
  742. 7420  PRINT TAB(T);
  743. 7430  PRINT"reactance to loss resistance."
  744. 7440  PRINT
  745. 7450  PRINT TAB(T);
  746. 7460  PRINT"For further reading on * refer to the RADIO ENGINEERS HANDBOOK"
  747. 7470  PRINT TAB(T);
  748. 7480  PRINT"by F.E.TERMAN, McGraw-Hill, NEW YORK, 1943, pages 210-215."
  749. 7490  PRINT
  750. 7500  PRINT " 6.";TAB(T);
  751. 7510  PRINT"Inductors (either air-core or toroid) of the exact values computed"
  752. 7520  PRINT TAB(T);
  753. 7530  PRINT"by this program may be designed using HAMCALC programs COIL DESIGNER"
  754. 7540  PRINT TAB(T);
  755. 7550  PRINT"and/or TOROID INDUCTORS."
  756. 7560  '
  757. 7570  GOSUB 9210
  758. 7580  GOTO 610
  759. 7590  '
  760. 7600  '.....Pi-Coupler SWR
  761. 7610  LOCATE 23:PRINT E$
  762. 7620  LOCATE 23,9
  763. 7630  PRINT "Do you wish to calculate SWR for variations in tuner values?  (y/n)"
  764. 7640  Y$=INKEY$:IF Y$=""THEN 7640
  765. 7650  IF Y$="N"OR Y$="n"THEN RETURN
  766. 7660  LOCATE 23:PRINT E$
  767. 7670  '
  768. 7680  LOCATE 23,2
  769. 7690  INPUT "ENTER: Tuner component values L(uH), C1(pF), C2(pF)";N1,N2,N3
  770. 7700  GOSUB 7810
  771. 7710  VIEW PRINT 22 TO 24:CLS:VIEW PRINT
  772. 7720  LOCATE 22,9
  773. 7730  PRINT "For L=";N1;"uH, C1=";N2;"pF, C2=";N3;"pF: SWR=";
  774. 7740  PRINT USING "##.##";SWR;:PRINT ":1"
  775. 7750  LOCATE 23,9:PRINT "Another SWR calculation?  (y/n)"
  776. 7760  Y$=INKEY$:IF Y$=""THEN 7760
  777. 7770  IF Y$="N"OR Y$="n"THEN LOCATE 23:PRINT E$:RETURN
  778. 7780  VIEW PRINT 22 TO 24:CLS:VIEW PRINT
  779. 7790  GOTO 7680
  780. 7800  '
  781. 7810  '.....calculation of SWR
  782. 7820  N4=N1*10^-6:N5=N2*10^-12:N6=N3*10^-12
  783. 7830  GL=RL/Z:BL=W*N6-XS/Z:NUM=GL^2+(BL-1/W/N4)^2
  784. 7840  M=1/(W*N4)^2*GL/NUM:N=W*N5-1/W/N4+1/(W*N4)^2/NUM*(1/W/N4-BL)
  785. 7850  RI=M/(M^2+N^2):XI=-N/(M^2+N^2)
  786. 7860  U=RI-R1:V=RI+R1:P=U^2+XI^2:Q=V^2+XI^2
  787. 7870  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  788. 7880  RETURN
  789. 7890  '
  790. 7900  '.....SPC SWR
  791. 7910  LOCATE 23:PRINT E$
  792. 7920  LOCATE 23,9
  793. 7930  PRINT "Do you wish to calculate SWR for variations in tuner values?  (y/n)"
  794. 7940  Y$=INKEY$:IF Y$="" THEN 7940
  795. 7950  IF Y$="N" OR Y$="n" THEN RETURN
  796. 7960  LOCATE 23:PRINT E$
  797. 7970  '
  798. 7980  LOCATE 23,2
  799. 7990  INPUT "ENTER: Tuner component values L(uH), C1(pF), C(pF)";N1,N2,N3
  800. 8000  GOSUB 8110
  801. 8010  VIEW PRINT 22 TO 24:CLS:VIEW PRINT
  802. 8020  LOCATE 22,9
  803. 8030  PRINT "For L=";N1;"uH, C1=";N2;"pF, C=";N3;"pF: SWR=";
  804. 8040  PRINT USING "##.##";SWR;:PRINT ":1"
  805. 8050  LOCATE 23,9:PRINT "Another SWR calculation?  (y/n)"
  806. 8060  Y$=INKEY$:IF Y$=""THEN 8060
  807. 8070  IF Y$="N"OR Y$="n"THEN LOCATE 23:PRINT E$:RETURN
  808. 8080  VIEW PRINT 22 TO 24:CLS:VIEW PRINT
  809. 8090  GOTO 7980
  810. 8100  '
  811. 8110  '.....calculation of SWR
  812. 8120  N4=N1*10^-6:N5=N2*10^-12:N6=N3*10^-12
  813. 8130  IF VER$="1"THEN DELTA=W*N6
  814. 8140  IF VER$="2"THEN DELTA=W*N5
  815. 8150  IF VER$="3"THEN DELTA=0
  816. 8160  XT=XS-1/W/N6:Z=RL^2+XT^2
  817. 8170  GL=RL/Z:BL=-(1/W/N4+XT/Z)+DELTA
  818. 8180  NUM=GL^2+BL^2:RI=GL/NUM:XI=-BL/NUM-1/W/N5
  819. 8190  U=RI-R1:V=RI+R1:P=U^2+XI^2:Q=V^2+XI^2
  820. 8200  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  821. 8210  RETURN
  822. 8220  '
  823. 8230  '.....Lowpass Tee SWR
  824. 8240  LOCATE 23,9
  825. 8250  PRINT "Do you wish to calculate SWR for variations in tuner values?  (y/n)"
  826. 8260  Y$=INKEY$:IF Y$=""THEN 8260
  827. 8270  IF Y$="N"OR Y$="n"THEN RETURN
  828. 8280  LOCATE 23:PRINT E$:LOCATE 23
  829. 8290  INPUT " ENTER: Tuner component values L1(>H), L2(>H), C(pF)";N1,N2,N3
  830. 8300  LOCATE 23:PRINT E$
  831. 8310  GOSUB 8400
  832. 8320  LOCATE 22,9:PRINT "For L1=";N1;">H, L2=";N2;">H, C=";N3;"pF: SWR=";
  833. 8330  PRINT USING "###.##";SWR;:PRINT ":1"
  834. 8340  LOCATE 23,9:PRINT "Another SWR calculation?  (y/n)"
  835. 8350  Y$=INKEY$:IF Y$=""THEN 8350
  836. 8360  IF Y$="N"OR Y$="n"THEN RETURN
  837. 8370  LOCATE 22:PRINT E$
  838. 8380  GOTO 8280
  839. 8390  '
  840. 8400  '.....SWR calculation
  841. 8410  N4=N1*10^-6:N5=N2*10^-6:N6=N3*10^-12
  842. 8420  XT=XS+W*N5:Z=RL^2+XT^2
  843. 8430  GL=RL/Z:BL=W*N6-XT/Z
  844. 8440  NUM=GL^2+BL^2:RI=GL/NUM:XI=-BL/NUM+W*N4
  845. 8450  U=RI-R1:V=RI+R1:P=U^2+XI^2:Q=V^2+XI^2
  846. 8460  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  847. 8470  RETURN
  848. 8480  '
  849. 8490  '.....ULTIMATE/SWR
  850. 8500  LOCATE 23,9
  851. 8510  PRINT "Do you wish to calculate SWR for variations in tuner values?  (y/n)"
  852. 8520  Y$=INKEY$:IF Y$=""THEN 8520
  853. 8530  IF Y$="N"OR Y$="n" THEN RETURN
  854. 8540  LOCATE 22:PRINT E$:PRINT E$:LOCATE 23
  855. 8550  INPUT " ENTER: Tuner component values L(>H), C1(pF), C(pF)";N1,N2,N3
  856. 8560  GOSUB 8660
  857. 8570  LOCATE 22,9
  858. 8580  PRINT "For L=";N1;">H, C1=";N2;"pF, C=";N3;"pF:  SWR=";
  859. 8590  PRINT USING "#.##";SWR;:PRINT ":1"
  860. 8600  PRINT E$
  861. 8610  LOCATE 23,9:PRINT "Another SWR calculation?  (y/n)"
  862. 8620  Y$=INKEY$:IF Y$=""THEN 8620
  863. 8630  IF Y$="N"OR Y$="n"THEN RETURN
  864. 8640  GOTO 8540
  865. 8650  '
  866. 8660  '.....calculation of SWR
  867. 8670  N4=N1*10^-6:N5=N2*10^-12:N6=N3*10^-12
  868. 8680  XT=XS-1/W/N6:Z=RL^2+XT^2
  869. 8690  GL=RL/Z:BL=-(1/W/N4+XT/Z)
  870. 8700  NUM1=GL^2+BL^2:RA=GL/NUM1:XA=-BL/NUM1-1/W/N5
  871. 8710  NUM2=RA^2+XA^2:GI=RA/NUM2:BI=W*N5-XA/NUM2
  872. 8720  NUM3=GI^2+BI^2:RI=GI/NUM3:XI=-BI/NUM3
  873. 8730  U=RI-R1:V=RI+R1:P=U^2+XI^2:Q=V^2+XI^2
  874. 8740  GAMMA=SQR(P/Q):SWR=(1+GAMMA)/(1-GAMMA)
  875. 8750  RETURN
  876. 8760  '
  877. 8770  '.....PI-COUPLER DELTA
  878. 8780  J=1+W^2*R1^2*C1^2:D1=J*XL/R1:JJ=1+W^2*R1^2*C1A^2:D2=JJ*XL/R1
  879. 8790  LOCATE 16,15
  880. 8800  IF C1>=0 AND C2-CP>=0 THEN PRINT "( * =";:PRINT USING "##.#";D1;:PRINT " )"
  881. 8810  LOCATE 19,15:PRINT "( * =";:PRINT USING "##.#";D2;:PRINT " )"
  882. 8820  RETURN
  883. 8830  '
  884. 8840  '.....LOWPASS TEE DELTA - solution 1
  885. 8850  L1A=L1*10^-6:J1=1-W^2*L1A*C:J2=W*C*R1
  886. 8860  D1=W/R1*(L1A+L2*(J1^2+J2^2))
  887. 8870  LOCATE 16,15:PRINT "*= ";:PRINT USING "##.#";D1
  888. 8880  RETURN
  889. 8890  '
  890. 8900  '.....LOWPASS TEE DELTA - solution 2
  891. 8910  L1A=L1*10^-6:J1=1-W^2*L1A*C:J2=W*C*R1
  892. 8920  D2=W/R1*(L1A+L2*(J1^2+J2^2))
  893. 8930  LOCATE 19,15:PRINT "*= ";:PRINT USING "##.#";D2
  894. 8940  RETURN
  895. 8950  '
  896. 8960  '......SPC Delta - Solution 1
  897. 8970  C1=C1*10^-12:D1=(1+1/(W^2*C1^2*R1^2))/W/L*R1:C1=C1*10^12
  898. 8980  LOCATE 16,15:PRINT "*= ";:PRINT USING "##.#";D1
  899. 8990  RETURN
  900. 9000  '
  901. 9010  '......SPC Delta - Solution 2
  902. 9020  C1=C1*10^-12:D2=(1+1/(W^2*C1^2*R1^2))/W/L*R1:C1=C1*10^12
  903. 9030  LOCATE 19,15:PRINT "*= ";:PRINT USING "##.#";D2
  904. 9040  RETURN
  905. 9050  '
  906. 9060  '.....ULTIMATE Delta - Solution 1
  907. 9070  C1=C1*10^-12:T=W*C1*R1:D1=(1+4*T^2)/(W^2*L*C1)/T:C1=C1*10^12
  908. 9080  LOCATE 16,15:PRINT "*= ";:PRINT USING "##.#";D1
  909. 9090  RETURN
  910. 9100  '
  911. 9110  '.....ULTIMATE Delta - Solution 2
  912. 9120  C1=C1*10^-12:T=W*C1*R1:D2=(1+4*T^2)/(W^2*L*C1)/T:C1=C1*10^12
  913. 9130  LOCATE 19,15:PRINT "*= ";:PRINT USING "##.#";D2
  914. 9140  RETURN
  915. 9150  '
  916. 9160  'end
  917. 9170  GOSUB 9210
  918. 9180  GOTO 160   'start
  919. 9190  END
  920. 9200  '
  921. 9210  'HARDCOPY
  922. 9220  GOSUB 9330:LOCATE 25,2:COLOR 14,6
  923. 9230  PRINT " Press 1 to print screen, 2 to print screen & ";
  924. 9240  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  925. 9250  Z$=INKEY$:IF Z$="3"THEN GOSUB 9330:RETURN
  926. 9260  IF Z$="1"OR Z$="2"THEN GOSUB 9330:GOTO 9280
  927. 9270  GOTO 9250
  928. 9280  FOR QX=1 TO 24:FOR QY=1 TO 80
  929. 9290  LPRINT CHR$(SCREEN(QX,QY));
  930. 9300  NEXT QY:NEXT QX
  931. 9310  IF Z$="2"THEN LPRINT CHR$(12)
  932. 9320  GOTO 9220
  933. 9330  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  934.